home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / EGAVGA.SWG / 0140_BGI BMP Files.pas < prev    next >
Pascal/Delphi Source File  |  1995-03-03  |  16KB  |  435 lines
  1. {
  2.   Subj: using brute force to load
  3. From: randyd@alpha2.csd.uwm.edu (Randall Elton Ding)
  4.  
  5. Some have been asking how to load bmp's and such from a file into
  6. the bgi..  Here is a brute force method for doing that in 16 color
  7. EGAVGA or HercMono modes.
  8.  
  9. There are two programs after this discussion, the first is the bmp
  10. utility and the second is a program that generates a bmp test pattern
  11. with the 16 standard colors used by the bmpgetimage example.
  12.  
  13. First - if you look at this program, then look in the manual, you will
  14. find that the manual is dead wrong about the setpalette procedure.
  15.  
  16.           Declaration:
  17.           procedure SetPalette(ColorNum: Word; Color: Shortint);
  18.  
  19.           Changes the ColorNum entry in the palette to Color.
  20. wrong --> SetPalette(0, LightCyan) makes the first color in the
  21.           palette light cyan. ColorNum can range from 0 to 15......
  22.  
  23. LightCyan is a constant and is equil to 11 but should be 59, see below.
  24. The color param used by setpalette proc is RGB defined in this way...
  25.  
  26.     bits: 0 = high intensity blue
  27.           1 = high intensity green
  28.           2 = high intensity red
  29.           3 = low intensity blue
  30.           4 = low intensity green
  31.           5 = low intensity red
  32.           6 = 0
  33.           7 = 0
  34.  
  35. The bmpgetimage procedure below reads the 64 byte pallet from the bmp
  36. and uses the 2 most sig bits from each BB GG RR 00 entry.
  37. This conversion is not the greatest but this is a brute force method.
  38.  
  39.  
  40. -------------- begin 1 of 2 programs ---------------
  41. }
  42. program bmp2bgi;
  43.  
  44. uses graph;
  45.  
  46. type
  47.   string80 = string[80];
  48.  
  49. { for vga putimage data, each line is repeated 4 times (4 bit planes) }
  50. { one for each color bit (16 color egavga) }
  51. { for hercmono, there is only 1 bit plane }
  52. { the word following the end of the last line
  53. { must be 00 00 in hercmono to tell BGI that there is only 1 bit plane }
  54. { for VGA the last word is 0F 00 ($000F) for 16 colors (4 bit planes) }
  55.  
  56. { ! must be in graphics mode to call this procedure }
  57. { does getimage like function on either 2 color or 4 color bmp file }
  58. { use dw=0 dh=0 to get bmp image from dx,dy to extreme edge }
  59. { this procedure will load a 2 color bmp as a B&W image into a 16 color
  60. { 4 bit plan putimage structure provided that the current video mode is }
  61. { egavga, but will not load a 16 color bmp into a single bit plane }
  62. { when the current video mode is hercmono }
  63. { no memory will be allocated if an error occurs (error when errs <> '') }
  64.  
  65. procedure bmpgetimage
  66.         (     fn          : string80;    { bmp file name }
  67.           var datapointer : pointer;     { ^ to putimage data }
  68.               dx,dy,dw,dh : word;        { offset into bmp & requested size }
  69.           var errs        : string80;    { error string, '' if none }
  70.           var palette     : palettetype; { returns converted EGA palette }
  71.           var size        : word);       { returns memory taken by image }
  72.                                          { for caller to release the memory }
  73.                                          { with freemem(datapointer,size); }
  74.   type
  75.     bmpheadtype = record
  76.  
  77.              { bit map file header }
  78.              bftype: word;                   { "BM" or $4D42 }
  79.              bfsize: longint;                { size of file in bytes }
  80.              bfreserved1: word;
  81.              bfreserved2: word;
  82.              bfoffbits: longint;             { ^ where graphic data begins }
  83.  
  84.              { bit map information header }
  85.              bisize: longint;                { length of this header, $28 }
  86.              biwidth: longint;               { pixel width }
  87.              biheight: longint;              { pixel height }
  88.              biplanes: word;                 { = 1 }
  89.              bibitcount: word;               { color bits per pixel }
  90.              bicompression: longint;         { = 0 for no compression }
  91.              bisizeimage: longint;           { = bfsize - bfoffbits }
  92.              bixpelspermeter: longint;       { x pixels per meter }
  93.              biypelspermeter: longint;       { y pixels per meter }
  94.              biclrused: longint;             { \ I have never seen these }
  95.              biclrimportant: longint;        { / two used for anything }
  96.            end;
  97.            { A note on windows BMP files.. }
  98.            { At this point in the bmp file, there is allocated }
  99.            { 1 longint for each color, RGB pallet data BB GG RR 00. }
  100.            { For greyscale viewing on color monitor, BB=GG=RR=shade }
  101.            { Number colors = 2^bibitcount, then pixel data follows. }
  102.            { For 16 colors, there are 64 bytes between header and }
  103.            { line data; Data lines are padded out to 32 bit incrimemts }
  104.            { also, bmp data is saved from bottom line up, and left to right }
  105.  
  106.   label badpalette,badread;
  107.  
  108.   const
  109.     maxbuf = 65520-1-4;  { -4 for iw and ih words }
  110.     defaultcolors: array[0..15] of byte =
  111.       (0,1,2,3,4,5,20,7,56,57,58,59,60,61,62,63);
  112.  
  113.   type buftype = record      { .data includes trailing word for # bitplanes }
  114.                    iw,ih: word;
  115.                    data : array[0..maxbuf] of byte;
  116.                  end;
  117.   var
  118.     f: file;
  119.     bmphead: bmpheadtype;
  120.     buf: ^buftype;
  121.     i,graphics,num,n,byteskip,bw,bw1,startbit: word;
  122.     dbyte,bit,bit1,x,y,loc,loc1,x1: word;
  123.     fs: longint;
  124.     rgbpalette: array[0..15,0..3] of byte;
  125.  
  126.   begin  { loadbmp }
  127.     errs:= '';
  128.     assign(f,fn);
  129.     {$I-}
  130.     reset(f,1);
  131.     {$I+}
  132.     if ioresult<>0 then begin
  133.       errs:= 'cannot open '+fn;
  134.       exit;
  135.     end;
  136.     blockread(f,bmphead,sizeof(bmphead),num);
  137.     if num < sizeof(bmphead) then begin
  138.       errs:= 'unexpected end of file';
  139.       close(f);
  140.       exit;
  141.     end;
  142.     with bmphead do begin
  143.       if (dw=0) and (biwidth>dx) then dw:= biwidth-dx;
  144.       if (dh=0) and (biheight>dy) then dh:= biheight-dy;
  145.       if (dx+dw>biwidth) or (dy+dh>biheight) or (dw=0) or (dh=0) then begin
  146.         errs:= 'x+width,y+height exceeds bmp bounds';
  147.         close(f);
  148.         exit;
  149.       end;
  150.       fs:= filesize(f);
  151.       if not ((bftype=$4D42) and (fs=bfsize) and (bisizeimage=fs-bfoffbits))
  152.       then begin
  153.         errs:= 'corrupt bmp file or not a bmp';
  154.         close(f);
  155.         exit;
  156.       end;
  157.       if not (bibitcount in [1,4]) then begin
  158.         errs:= 'bmp must be 2 or 16 color';
  159.         close(f);
  160.         exit;
  161.       end;
  162.  
  163.       graphics:= 0;
  164.       size:= imagesize(dx,dy,dx+dw-1,dy+dh-1);
  165.       if (graphresult=grerror) or (size-4 > maxbuf+1) then begin
  166.         errs:= 'image too large';
  167.         close(f);
  168.         exit;
  169.       end;
  170.       bw1:= dw div 8;
  171.       if dw mod 8 > 0 then bw1:= bw1 + 1;
  172.       if bw1*dh*4+6=size then graphics:= 4;  { figure out what video mode }
  173.       if bw1*dh+6=size then graphics:= 1;    { we are in, 1 or 4 bit planes }
  174.       if graphics=0 then begin               { graphics = # bit planes to }
  175.         errs:= 'internal error';             { save putimage data with }
  176.         close(f);
  177.         exit;
  178.       end;
  179.       if (graphics=1) and (bibitcount>1) then begin
  180.         errs:= 'bmp must be 2 color for present graphics mode';
  181.         close(f);
  182.         exit;
  183.       end;
  184.  
  185.       getmem(datapointer,size);
  186.       buf:= datapointer;
  187.       n:= 32 div bibitcount;              { pixels per longint }
  188.       bw:= biwidth div n;                 { longint width of one line }
  189.       if biwidth mod n > 0 then bw:= bw + 1;
  190.       bw:= bw * n;                        { line length to nearest 32 pixels }
  191.       n:= n div 4;                        { pixels per byte }
  192.       byteskip:= (dx+dw) div n;
  193.       if (dx+dw) mod n > 0 then byteskip:= byteskip + 1;
  194.       byteskip:= byteskip * n;
  195.       byteskip:= (bw-byteskip) div n;     { bytes to skip at end of line }
  196.       startbit:= dx mod n;                { starting bit position }
  197.       dx:= dx div n;                      { x byte offset into data }
  198.       byteskip:= byteskip + dx;           { add bytes to skip at beginning }
  199.       bw:= bw div n;                      { byte length of line }
  200.  
  201.       if (graphics=4) and (bibitcount=4) then begin
  202.         {$I-}
  203.         seek(f,bisize+14);
  204.         {$I+}
  205.         if ioresult<>0 then goto badpalette;
  206.         blockread(f,rgbpalette,sizeof(rgbpalette),num);
  207.         if num<>sizeof(rgbpalette) then begin
  208.           badpalette:
  209.           errs:= 'error reading bmp palette';
  210.           close(f);
  211.           freemem(datapointer,size);
  212.           exit;
  213.         end;
  214.         getpalette(palette);
  215.         if palette.size = 16 then for i:= 0 to 15 do begin
  216.           dbyte:= 0;
  217.           if rgbpalette[i,2] and $80 = $80 then dbyte:= dbyte or $04;
  218.           if rgbpalette[i,2] and $40 = $40 then dbyte:= dbyte or $20;
  219.           if rgbpalette[i,1] and $80 = $80 then dbyte:= dbyte or $02;
  220.           if rgbpalette[i,1] and $40 = $40 then dbyte:= dbyte or $10;
  221.           if rgbpalette[i,0] and $80 = $80 then dbyte:= dbyte or $01;
  222.           if rgbpalette[i,0] and $40 = $40 then dbyte:= dbyte or $08;
  223.           palette.colors[i]:= dbyte;
  224.         end;
  225.       end;
  226.       if (graphics=4) and (bibitcount=1) then begin
  227.         getpalette(palette);
  228.         if palette.size = 16 then move(defaultcolors,palette.colors,16);
  229.       end;
  230.       if graphics=1 then getpalette(palette);
  231.  
  232.       {$I-}
  233.       seek(f,bfoffbits);
  234.       {$I+}
  235.       if (ioresult<>0) or (fs-filepos(f) <> bw*biheight) then begin
  236.         errs:= 'bad bmp file length, doesn''t match image size parameters';
  237.         close(f);
  238.         freemem(datapointer,size);
  239.         exit;
  240.       end;
  241.       {$I-}                        { !! bmp's are saved from bottom up !! }
  242.       seek(f,bfoffbits + (biheight-dh-dy)*bw + dx);
  243.       {$I+}
  244.       if ioresult<>0 then goto badread;
  245.       fillchar(buf^,size,#0);
  246.       buf^.iw:= dw-1;         { bgi putimage data has width & height values }
  247.       buf^.ih:= dh-1;         { stored as width-1, height-1 }
  248.       for y:= dh-1 downto 0 do begin
  249.         bit:= startbit;
  250.         blockread(f,dbyte,1,num);
  251.         if num <> 1 then goto badread;
  252.         loc:= bw1*y*graphics;
  253.         bit1:= $80;
  254.         x1:= 0;
  255.         for x:= 0 to dw-1 do begin
  256.           loc1:= loc+x1;
  257.           if graphics <> bibitcount then dbyte:= (dbyte and $FF) shl 1;
  258.           for i:= 0 to graphics-1 do begin
  259.             if graphics = bibitcount then dbyte:= (dbyte and $FF) shl 1;
  260.             if hi(dbyte)=1 then buf^.data[loc1]:= buf^.data[loc1] or bit1;
  261.             loc1:= loc1+bw1;
  262.           end;
  263.           bit1:= bit1 shr 1;
  264.           if bit1=0 then begin
  265.             bit1:= $80;
  266.             x1:= x1+1;
  267.           end;
  268.           bit:= bit+1;
  269.           if (bit >= n) and (x<dw-1) then begin
  270.             bit:= 0;
  271.             blockread(f,dbyte,1,num);
  272.             if num <> 1 then goto badread;
  273.           end;
  274.         end;
  275.         if (byteskip>0) and (y>0) then begin
  276.           {$I-}
  277.           seek(f,filepos(f)+byteskip);
  278.           {$I+}
  279.           if ioresult<>0 then begin
  280.             badread:
  281.             errs:= 'error reading bmp data';
  282.             close(f);
  283.             freemem(datapointer,size);
  284.             exit;
  285.           end;
  286.         end;
  287.       end;
  288.       close(f);
  289.       loc1:= dh*bw1*graphics;    { set number of bitplanes parameter }
  290.       buf^.data[loc1+1]:= 0;
  291.       if bibitcount = 4 then buf^.data[loc1]:= $F else buf^.data[loc1]:= 0;
  292.     end;
  293.   end;  { bmpgetimage }
  294.  
  295.  
  296.  
  297. procedure example;
  298.   var
  299.     p: pointer;
  300.     i,x,y,w,h,size: word;
  301.     errs: string80;
  302.     grmode,grdriver,errcode: integer;
  303.     palette,origpalette: palettetype;
  304.  
  305.   begin
  306.     grdriver:= detect;
  307.     initgraph(grdriver,grmode,'e:\bp\bgi');
  308.     errcode:= graphresult;
  309.     if errcode <> grok then begin
  310.       writeln('Graphics error: ',grapherrormsg (errcode));
  311.       halt(1);
  312.     end;
  313.     x:= 0;   { start reading the bmp data from 0,0 }
  314.     y:= 0;
  315.     w:= 0;   { w=0 means tells bmpgetimage to use maximum width of bmp }
  316.     h:= 0;   { h=0 same here }
  317.     bmpgetimage('d:\windows\winlogo.bmp',p,x,y,w,h,errs,palette,size);
  318.     if errs='' then begin       { test error string for possible error }
  319.       getpalette(origpalette);
  320.       setallpalette(palette);
  321.       putimage(0,0,p^,normalput);
  322.       readln;
  323.       setallpalette(origpalette);
  324.       closegraph;
  325.       freemem(p,size);
  326.     end
  327.     else begin
  328.       closegraph;
  329.       writeln(errs);
  330.       readln;
  331.     end;
  332.   end;
  333.  
  334.  
  335. begin
  336.   example;
  337. end.
  338.  
  339. {
  340. ------------- end first program, begin second program --------------
  341. }
  342. { makes a test pattern bmp file with correct palette, 640x128, 4 bits/pixel }
  343. program makebmptestpattern;
  344. type
  345.   bmpheadtype = record
  346.  
  347.            { bit map file header }
  348.            bftype: word;                   { "BM" or $4D42 }
  349.            bfsize: longint;                { size of file in bytes }
  350.            bfreserved1: word;
  351.            bfreserved2: word;
  352.            bfoffbits: longint;             { ^ where graphic data begins }
  353.  
  354.            { bit map information header }
  355.            bisize: longint;                { length of this header, $28 }
  356.            biwidth: longint;               { pixel width }
  357.            biheight: longint;              { pixel height }
  358.            biplanes: word;                 { = 1 }
  359.            bibitcount: word;               { color bits per pixel }
  360.            bicompression: longint;         { = 0 for no compression }
  361.            bisizeimage: longint;           { = bfsize - bfoffbits }
  362.            bixpelspermeter: longint;       { x pixels per meter }
  363.            biypelspermeter: longint;       { y pixels per meter }
  364.            biclrused: longint;             { \ I have never seen these }
  365.            biclrimportant: longint;        { / two used for anything }
  366.          end;
  367.  
  368. type
  369.   paltype = array[0..15,0..3] of byte;
  370.   bodytype = array[0..127,0..319] of byte;
  371.   buftype = record
  372.               head: bmpheadtype;
  373.               pal : paltype;
  374.               body: bodytype;
  375.             end;
  376.   colorstype = array[0..15] of byte;
  377.  
  378. const
  379.   colors: colorstype = (0,1,2,3,4,5,20,7,56,57,58,59,60,61,62,63);
  380.  
  381.  
  382. var
  383.   f: file;
  384.   buf: ^buftype;
  385.   r,g,b,i,x,y,c: integer;
  386.  
  387.  
  388. begin
  389.   new(buf);
  390.   with buf^,buf^.head do begin
  391.     for i:= 0 to 15 do begin
  392.       r:= 0;  g:= 0;  b:= 0;
  393.       if colors[i] and 1 = 1 then b:= b + 128;
  394.       if colors[i] and 2 = 2 then g:= g + 128;
  395.       if colors[i] and 4 = 4 then r:= r + 128;
  396.       if colors[i] and 8 = 8 then b:= b + 64;
  397.       if colors[i] and 16 = 16 then g:= g + 64;
  398.       if colors[i] and 32 = 32 then r:= r + 64;
  399.       pal[i,0]:= b;
  400.       pal[i,1]:= g;
  401.       pal[i,2]:= r;
  402.       pal[i,3]:= 0;
  403.     end;
  404.     for y:= 0 to 127 do
  405.       for x:= 0 to 319 do begin
  406.         c:= (x div 10) mod 16;
  407.         c:= (c shl 4) + c;
  408.         body[y,x]:= c;
  409.       end;
  410.     bftype:= $4D42;                 { "BM" or $4D42 }
  411.     bfsize:= sizeof(buf^);          { size of file in bytes }
  412.     bfreserved1:= 0;
  413.     bfreserved2:= 0;
  414.     bfoffbits:= 14+40+64;           { where graphic data begins }
  415.     bisize:= 40;                    { length of this header }
  416.     biwidth:= 640;                  { pixel width }
  417.     biheight:= 128;                 { pixel height }
  418.     biplanes:= 1;                   { =1 }
  419.     bibitcount:= 4;                 { color bits per pixel }
  420.     bicompression:= 0;              { =0 for no compression }
  421.     bisizeimage:= bfsize-bfoffbits;
  422.     bixpelspermeter:= 0;
  423.     biypelspermeter:= 0;
  424.     biclrused:= 0;
  425.     biclrimportant:= 0;
  426.   end;
  427.   assign(f,'testpat.bmp');
  428.   rewrite(f,1);
  429.   blockwrite(f,buf^,sizeof(buf^));
  430.   close(f);
  431. end.
  432.  
  433. {
  434. --------------- end of programs ---------------
  435. }